home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / grafix / misc / phcd_21.lha / PhotoCD < prev   
Encoding:
Text File  |  1995-01-03  |  11.5 KB  |  415 lines
  1. /*
  2. ** PhotoCD
  3. **
  4. ** $VER: ADPro PhotoCD Loader 2.1 (2.1.95)
  5. ** Loader for Photo-CD-Pictures in ADPro together with AsimPhoto or hpcdtoppm.
  6. ** Copyright © 1994-1995 Erik Simonson
  7. ** All Rights Reserved
  8. */
  9.  
  10. OPTIONS RESULTS
  11.  
  12. SIGNAL ON BREAK_C
  13. SIGNAL ON BREAK_D
  14. SIGNAL ON HALT
  15. SIGNAL ON SYNTAX
  16.  
  17. /*TRACE(RESULTS)*/
  18.  
  19.  
  20. ADPro            = '"ADPro PhotoCD-loader"'
  21. NL               = '0a'x
  22. NeedPrefsversion = 1.2
  23. PrefsFile        = "ENV:ADPro/PhotoCD.prefs"
  24.  
  25. IF ~SHOW('L',"rexxsupport.library") THEN
  26.   IF ~ADDLIB('rexxsupport.library',0,-30,0) THEN
  27.     CALL Quit("Couldn't open 'rexxsupport.library', you must\ninstall it before using this program.")
  28.  
  29. Complete = 0
  30. DO WHILE Complete ~= 2
  31.   IF OPEN(Prefs,PrefsFile,"R") THEN DO
  32.     Complete = 1
  33.     OpenPrefs = 1
  34.     DO i=1 TO 3
  35.       READLN(Prefs)
  36.     END
  37.     Prefsversion=WORD(READLN(Prefs),3)
  38.     IF Prefsversion = NeedPrefsversion THEN DO
  39.  
  40.       /* Läser in konverteringsprogram */
  41.       ConvProg = READLN(Prefs)
  42.       ConvProg = RIGHT(ConvProg,LENGTH(ConvProg)-16)
  43.       IF UPPER(ConvProg) ~= "ASIMPHOTO" & UPPER(ConvProg) ~= "HPCDTOPPM" THEN ConvProg = "CONVPROG"
  44.  
  45.       /* Läser in sökväg för konverteringsprogram */
  46.       Conv=READLN(Prefs)
  47.       CALL Signs(RIGHT(Conv,LENGTH(Conv)-16),'"')
  48.       ConvProgPath = String
  49.       CALL CheckPath("File",ConvProgPath)
  50.       IF Correct = 0 THEN ConvProgPath = "CONVPROGPATH"
  51.  
  52.       /* Läser in språk */
  53.       Language=WORD(READLN(Prefs),3)
  54.  
  55.       /* Läser in arbetskatalog */
  56.       Work=READLN(Prefs)
  57.       CALL Signs(RIGHT(Work,LENGTH(Work)-16),'"')
  58.       WorkDir = String
  59.       IF LEFT(RIGHT(WorkDir,2),1) ~= ':' THEN DO
  60.         CALL CheckPath("Dir",WorkDir)
  61.         IF Correct = 0 THEN WorkDir = "WORKDIR"
  62.       END
  63.       CLOSE(Prefs)
  64.     END
  65.     ELSE
  66.       CLOSE(Prefs)
  67.   END
  68.   ELSE
  69.     PrefsFile = "ENV:ADPro/PhotoCD.prefs"
  70.   Complete = Complete + 1
  71. END
  72.  
  73. ADDRESS "ADPro"
  74. DISPLAYMESSAGE ADPro
  75.  
  76. IF OpenPrefs = "OPENPREFS" | Prefsversion = "PREFSVERSION" THEN
  77.     OKAY1 '"While this is the first time you use this\nprogram you have to set the preferences."'
  78.  
  79. IF OpenPrefs = 1 & Prefsversion > NeedPrefsversion THEN
  80.     OKAY1 '"Get a newer version of this program!"'
  81.   
  82. /* Asking which language to use */
  83. Resultat = 1
  84. IF Language = "LANGUAGE" THEN DO
  85.   DO WHILE Resultat ~= 0
  86.     LISTVIEW '"Language ?"' 2 NOSELECT SORT ITEMS "English Svenska"
  87.     Resultat = RC
  88.     IF Resultat = 0 THEN Language = WORD(ADPRO_RESULT,1)
  89.     ELSE DO
  90.       OKAYN '"Language selection"' '"No language selected, you must select\none before using this program."' "Select|Cancel"
  91.       IF RC = 0 THEN CALL Quit
  92.     END
  93.   END
  94. END
  95.  
  96.  
  97. /* Strings, translate them if you want to, but notice
  98. ** that you have to doublequote strings with spaces.
  99. */
  100.  
  101. IF Language = '"English"' THEN DO
  102.  
  103.     ProgReq   = '"Select conversion program..."'
  104.     ProgMess  = '"No conversion program selected, you must\nselect one before using this program."'
  105.     ProgChoi  = "Select|Cancel"
  106.  
  107.     ConvProgReq = '"Select the conversion program you are using"'
  108.  
  109.     WorkReq   = '"Work in directory..."'
  110.     WorkMess  = '"No workdirectory selected, you must\nselect one before using this program."'
  111.  
  112.     PrefMess  = '"In which way do you want to save the preferences?"'
  113.     Cancel    = "Cancel"
  114.     Save      = "Save"
  115.     Use       = "Use"
  116.     PrefsMess = '"The preferences could only be saved temporarily\nin Ram:, and because of that will not be found\nthe next time after a cold reboot."'
  117.  
  118.     FileReq   = '"Select PhotoCD Image File to Load"'
  119.     FileMess  = '"No picture selected, do you want to quit?"'
  120.     FileChoi  = "Select|Yes"
  121.  
  122.     ComQuality= '"Select compression quality"'
  123.     ComQuaMess= '"No compression quality selected, do you want to quit?"'
  124.  
  125.     ResReq    = '"In which resolution do you want\nto have the converted picture?"'
  126.     Resolution= '"Resolution ?"'
  127.     ResMess   = '"No resolution selected, do you want to quit?"'
  128.  
  129.     ConvMess  = '"Converting picture..."'
  130.  
  131.     SmoothMess= '"Do you want smoothing?"'
  132.     SmoothChoi= "Yes|No"
  133.  
  134. END
  135.  
  136.  
  137. /* Swedish strings */
  138.  
  139.   ELSE IF Language = '"Svenska"' THEN DO
  140.  
  141.     ProgReq   = '"Välj konverteringsprogram..."'
  142.     ProgMess  = '"Inget konverteringsprogram valt, du måste\nvälja ett för att använda detta program."'
  143.     ProgChoi  = "Välj|Avbryt"
  144.  
  145.     ConvProgReq = "'Vilket konverteringsprogram använder du?'"
  146.  
  147.     WorkReq   = '"Arbeta i katalog..."'
  148.     WorkMess  = '"Ingen arbetskatalog vald, du måste välja\nett för att använda detta program."'
  149.  
  150.     PrefMess  = '"Hur vill du spara inställningarna?"'
  151.     Cancel    = "Avbryt"
  152.     Save      = "Spara"
  153.     Use       = "Använd"
  154.     PrefsMess = '"Inställningarna kunde bara sparas temporärt\ni Ram:, och kommer på grund av det att vara\nborta nästa gång datorn slås på."'
  155.  
  156.     FileReq   = '"Öppna Photo-CD-bild..."'
  157.     FileMess  = '"Ingen bild vald, vill du avsluta?"'
  158.     FileChoi  = "Välj|Ja"
  159.  
  160.     ComQuality= '"Välj bildkvalité/packningsgrad"'
  161.     ComQuaMess= '"Ingen bildkvalité/packningsgrad vald, vill du avsluta?"'
  162.  
  163.     ResReq    = '"Vilken upplösning vill du ha\npå den konverterade bilden?"'
  164.     Resolution= '"Upplösning ?"'
  165.     ResMess   = '"Ingen upplösning vald, vill du avsluta?"'
  166.  
  167.     ConvMess  = '"Konverterar bilden..."'
  168.  
  169.     SmoothMess= '"Vill du ha utjämning av bilden?"'
  170.     SmoothChoi= "Ja|Nej"
  171.  
  172.   END
  173.  
  174. /* End strings */
  175.  
  176.  
  177. /* Asking for conversionprogram */
  178. IF ConvProgPath = "CONVPROGPATH" THEN DO
  179.   Correct = 0
  180.   DO WHILE Correct = 0
  181.     CALL FilePath("File",ProgReq,"DH0:Graphics",,ProgMess,ProgChoi)
  182.     ConvProgPath = '"'String'"'
  183.     CheckPath("File",ConvProgPath)
  184.     SavePrefs = 1
  185.   END
  186.   /* Checking which conversionprogram is used */
  187.   Teckennr = 1
  188.   TestConvProg = ""
  189.   ConvProgSign = ""
  190.   DO WHILE ConvProgSign ~= "/" & ConvProgSign ~= '"'
  191.     TestConvProg = INSERT(ConvProgSign,TestConvProg)
  192.     Teckennr = Teckennr + 1
  193.     ConvProgSign = LEFT(RIGHT(ConvProgPath,Teckennr),1)
  194.   END
  195.   IF UPPER(TestConvProg) = "ASIMPHOTO" | UPPER(TestConvProg) = "HPCDTOPPM" THEN
  196.     ConvProg = TestConvProg
  197. END
  198. IF ConvProg = "CONVPROG" THEN DO
  199.   ConvProg = 'AsimPhoto'
  200.   OKAYN ADPro ConvProgReq "AsimPhoto"'|'"HpCDToPpm"
  201.   IF RC = 0 THEN ConvProg = 'HpCDToPpm'
  202.   SavePrefs = 1
  203. END
  204.  
  205. /* Asking for workdirectory */
  206. IF WorkDir = "WORKDIR" THEN DO
  207.   CALL FilePath("Dir",WorkReq,"T:",,WorkMess,ProgChoi)
  208.   WorkDir = '"'String'"'
  209.   SavePrefs = 1
  210. END
  211. IF RIGHT(WorkDir,2) = ':"' THEN
  212.   WorkFile = INSERT(LEFT(WorkDir,(LENGTH(WorkDir)-1)),"ADPPHCDLOAD")'"'
  213. ELSE
  214.   WorkFile = INSERT(LEFT(WorkDir,(LENGTH(WorkDir)-1)),"/ADPPHCDLOAD")'"'
  215.  
  216.  
  217. /* Save prefs */
  218. IF SavePrefs = 1 THEN DO
  219.   OKAYN ADPro PrefMess Save'|'Use'|'Cancel
  220.   SELECT
  221.     WHEN RC = 1 THEN Save = 2
  222.     WHEN RC = 2 THEN Save = 1
  223.     WHEN RC = 0 THEN Save = 0
  224.   END
  225.   IF Save ~= 0 THEN DO
  226.     Resultat = 0
  227.     DO WHILE Resultat < Save
  228.       IF OPEN(Prefs,PrefsFile,"W") THEN DO
  229.         WriteLn(Prefs,"These are the current preferences for ADPro PhotoCD Loader.")
  230.         WriteLn(Prefs,"1994-1995 © Erik Simonson")
  231.         WriteLn(Prefs,"")
  232.         WriteLn(Prefs,"Prefsversion  = "||NeedPrefsversion)
  233.         WriteLn(Prefs,"ConvProg      = "||ConvProg)
  234.         WriteLn(Prefs,"ConvProgPath  = "||ConvProgPath)
  235.         WriteLn(Prefs,"Language      = "||Language)
  236.         WriteLn(Prefs,"Work-Dir      = "||WorkDir)
  237.         CLOSE(Prefs)
  238.       END
  239.       ELSE
  240.         OKAY1 PrefsMess
  241.       Resultat = Resultat + 1
  242.       PrefsFile = "ENVARC:ADPro/PhotoCD.prefs"
  243.     END
  244.     IF Resultat = 1 & Save = 2 THEN
  245.       OKAY1 PrefsMess
  246.   END
  247. END
  248.  
  249.  
  250. /* Asking for picture and resolution for it */
  251. CALL FilePath("File",FileReq,"CD0:PHOTO_CD/IMAGES",,FileMess,FileChoi)
  252.  
  253. IF ConvProg = "AsimPhoto" THEN DO          /* AsimPhoto */
  254.   ConvProgCom = ConvProgPath "From" String
  255.   OKAYN ADPro ResReq INSERT("768x512|384x256|192x128|",Cancel)
  256.   SELECT
  257.     WHEN RC = 1 THEN DestFil = ' To '||WorkFile||' Resolution base'
  258.     WHEN RC = 2 THEN DestFil = ' To '||WorkFile||' Resolution base4'
  259.     WHEN RC = 3 THEN DestFil = ' To '||WorkFile||' Resolution base16'
  260.     WHEN RC = 0 THEN CALL Quit
  261.   END
  262. END
  263. ELSE DO
  264.   Resultat = 10
  265.   DO WHILE Resultat = 10
  266.     GETNUMBER ComQuality 80 0 100  
  267.     Resultat = RC
  268.     IF Resultat = 10 THEN DO
  269.       OKAYN ADPro ComQuaMess FileChoi
  270.       IF RC = 0 THEN CALL Quit
  271.     END
  272.   END
  273.   Quality# = ADPRO_RESULT
  274.   DestFil = ' -jpeg -quality '||Quality#||' '||String||' '||WorkFile||''
  275.   Resultat = 5
  276.   DO WHILE Resultat = 5
  277.     LISTVIEW Resolution 6 NOSELECT ITEMS "128x192 256x384 512x768 1024x1536 2048x3072 4096x6144"
  278.     Resultat = RC
  279.     IF Resultat = 5 THEN DO
  280.       OKAYN ADPro ResMess FileChoi
  281.       IF RC = 0 THEN CALL Quit
  282.     END
  283.   END
  284.  
  285.   Res = WORD(ADPRO_RESULT,1)
  286.   SELECT
  287.     WHEN Res = '"128x192"' THEN ConvProgCom = ConvProgPath||' -1'
  288.     WHEN Res = '"256x384"' THEN ConvProgCom = ConvProgPath||' -2'
  289.     WHEN Res = '"512x768"' THEN ConvProgCom = ConvProgPath||' -3'
  290.     WHEN Res = '"1024x1536"' THEN ConvProgCom = ConvProgPath||' -4'
  291.     WHEN Res = '"2048x3072"' THEN ConvProgCom = ConvProgPath||' -5'
  292.     WHEN Res = '"4096x6144"' THEN ConvProgCom = ConvProgPath||' -6'
  293.   END
  294. END
  295.  
  296. /* Converting image */
  297. DISPLAYMESSAGE ConvMess
  298. ADDRESS COMMAND
  299. INSERT(ConvProgCom,Destfil)
  300.  
  301. ADDRESS "ADPro"
  302. DISPLAYMESSAGE ADPro
  303.  
  304. /* Open picture */
  305. ADDRESS "ADPro"
  306. IF ConvProg = "AsimPhoto" THEN
  307.   LOADER "IFF" WorkFile
  308. ELSE DO
  309.   OKAYN ADPro SmoothMess SmoothChoi
  310.   IF RC = 1 THEN
  311.     LOADER "JPEG" WorkFile SMOOTHING
  312.   ELSE
  313.     LOADER "JPEG" WorkFile
  314. END
  315. CALL Quit
  316.  
  317. CheckPath:
  318.   PARSE ARG Type,Path
  319.   Correct = 0
  320.   Leng = LENGTH(Path)
  321.  
  322.   IF Type = "File" THEN
  323.     IF OPEN(Test,RIGHT(LEFT(Path,Leng-1),Leng-2),"R") THEN DO
  324.       CLOSE(Test)
  325.       Correct = 1
  326.     END
  327.   ELSE IF Type = "Dir" & RIGHT(Path,1) = ':' THEN
  328.     IF SHOWLIST('V',UPPER(LEFT(Path,Leng-1))) THEN Correct = 1
  329.  
  330.   IF Correct = 0 THEN DO
  331.     Number = 1
  332.     String = ""
  333.     Resultat = 1
  334.     DO WHILE Resultat ~= 0
  335.       Sign = LEFT(RIGHT(Path,Number),1)
  336.       IF Sign ~= '/' & Sign ~= ':' THEN DO
  337.         Number = Number + 1
  338.         String = INSERT(Sign,String)
  339.       END
  340.       ELSE DO
  341.         SignEnd = RIGHT(String,1)
  342.         IF SignEnd = '"' THEN
  343.           String = LEFT(String,(LENGTH(String)-1))
  344.         Resultat = 0
  345.         Correct = 0
  346.         IF Sign = "/" THEN DO
  347.           Word  = LEFT(Path,(Leng-Number))
  348.           IF LEFT(Word,1) = '"' THEN
  349.             Word = RIGHT(Word,LENGTH(Word)-1)
  350.         END
  351.         ELSE DO
  352.           LeftWord  = LEFT(Path,(Leng-Number+1))
  353.           LengLeftWord = LENGTH(LeftWord)
  354.           Word = RIGHT(LeftWord,LengLeftWord-1)
  355.         END
  356.         List = SHOWDIR(Word, 'd')
  357.         WordNumber = WORDS(List)
  358.         Number = 1
  359.         DO WHILE Correct = 0 & Number < WordNumber + 1
  360.           IF WORD(List,Number) ~= String THEN
  361.           Number = Number + 1
  362.           ELSE
  363.             Correct = 1
  364.         END
  365.       END
  366.     END
  367.   END
  368. RETURN Correct
  369.  
  370.  
  371. FilePath:
  372.   PARSE ARG Type,Title,DefaultDir,DefaultFile,Mess,Choices
  373.   ADDRESS "ADPro"
  374.   Resultat = 1
  375.   DO WHILE Resultat ~= 0
  376.     IF Type = "File" THEN DO
  377.       GETFILE Title DefaultDir DefaultFile
  378.       Resultat = RC
  379.       IF Resultat ~= 0  THEN DO
  380.           OKAYN ADPro Mess Choices
  381.           IF RC = 0 THEN CALL Quit
  382.       END
  383.       String = ADPRO_RESULT
  384.     END
  385.     ELSE
  386.     IF Type = "Dir" THEN DO
  387.       GETDIR Title DefaultDir
  388.       Resultat = RC
  389.       IF Resultat ~= 0 THEN DO
  390.         OKAYN ADPro Mess Choices
  391.         IF RC = 0 THEN CALL Quit
  392.       END
  393.       String = ADPRO_RESULT
  394.     END
  395.   END
  396. RETURN String
  397.  
  398. Signs:
  399.   PARSE ARG String,Sign
  400.   StringLength = LENGTH(String)
  401.   IF LEFT(String,1) ~= Sign THEN
  402.     String = INSERT(Sign,String)
  403.   IF RIGHT(String,1) ~= Sign THEN
  404.     String = INSERT(String,Sign)
  405. RETURN String
  406.  
  407. Quit:
  408. PARSE ARG String
  409. ADDRESS "ADPro"
  410. IF String ~= "" THEN OKAY1 String
  411. DISPLAYMESSAGE
  412. ADDRESS COMMAND
  413. "DELETE "||INSERT(LEFT(WorkFile,(LENGTH(WorkFile)-1)),'#?"')
  414. EXIT 0
  415.